home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
butt01.zip
/
BPTEST.PRG
< prev
next >
Wrap
Text File
|
1993-01-04
|
13KB
|
372 lines
* Program.: BPTEST.PRG
* Author..: Charles Alan Butler
* Date....: 04/04/90
* Notice..: Copyright (c) 1990,MIS Consulting, All Rights Reserved
* Notes...: Template Button Menu Ver(1) 4/4/90 *CAB*
* Notes...: Target Language is FoxPro.
**** Debug *****
DO set_fox
DO mis_logo
**** Debug *****
** -- Save some of the calling environment
ButtSch1=SCHEME(1) && SAVE Colors [FoxPro]
ButtSch2=SCHEME(2) && SAVE Colors [FoxPro]
** -- Declare private variables
PRIVATE ButRef,ButtColor,ButtScrn,cnt,ColorStr,LastColor
PRIVATE Mpt,MaxMpt,SayString
DIMENSION GroupFlag(17)
** Flag Groups as follows
** Value of 1 to n = Radio Button Groups
** Value of 0 = Check Box
** Value of -1 = Proceed Text Button
** Value of -2 = Abort Text Button
** Value of -3 = Menu Choice Text Button
GroupFlag( 1)=1 && Button Group
GroupFlag( 2)=1 && Button Group
GroupFlag( 3)=2 && Button Group
GroupFlag( 4)=2 && Button Group
GroupFlag( 5)=3 && Button Group
GroupFlag( 6)=3 && Button Group
GroupFlag( 7)=3 && Button Group
GroupFlag( 8)=4 && Button Group
GroupFlag( 9)=4 && Button Group
GroupFlag(10)=4 && Button Group
GroupFlag(11)=0 && Check Box
GroupFlag(12)=0 && Check Box
GroupFlag(13)=0 && Check Box
GroupFlag(14)=0 && Check Box
GroupFlag(15)=-3 && Menu Item
GroupFlag(16)=-1 && Proceed
GroupFlag(17)=-2 && ESCape
** Set true defaults, one per Radio Group
IF TYPE('T_F(17)') # 'L' && Skip if already defined RELEASE T_F
PUBLIC T_F(17)
T_F( 2)=.T. && Button Group 1
T_F( 3)=.T. && Button Group 2
T_F( 5)=.T. && Button Group 3
T_F( 9)=.T. && Button Group 4
T_F(11)=.T. && Check Box
ENDIF
IF TYPE('Ky') # 'N' && Skip if already defined
RELEASE Ky
PUBLIC Ky && Returns the ASCII number of the exit key
ENDIF
DIMENSION SayAry(17) && -- Array Used to Display Choices --
DIMENSION HotKey(17) && -- Array Used to Display Hot Keys --
SayAry( 1)='@ 2, 3 SAY "( ) ALL "'
HotKey(1) = "A 7r+/n"
SayAry( 2)='@ 3, 3 SAY "( ) Select "'
SayAry( 3)='@ 2,25 SAY "( ) Incomplete Jobs"'
SayAry( 4)='@ 3,25 SAY "( ) All Jobs "'
HotKey(4) = "J33r+/n"
SayAry( 5)='@ 6, 3 SAY "( ) Subdivision "'
SayAry( 6)='@ 7, 3 SAY "( ) Address "'
SayAry( 7)='@ 8, 3 SAY "( ) Job Number "'
SayAry( 8)='@ 6,25 SAY "( ) Printer "'
HotKey(8) = "P29r+/n"
SayAry( 9)='@ 7,25 SAY "( ) Screen "'
SayAry(10)='@ 8,25 SAY "( ) File "'
SayAry(11)='@ 11, 3 SAY "[ ] Balance Due"'
SayAry(12)='@ 12, 3 SAY "[ ] Phone Number"'
HotKey(12) = "o 9gr+/n"
SayAry(13)='@ 11,25 SAY "[ ] Projected Bala"'
SayAry(14)='@ 12,25 SAY "[ ] Projected Cost"'
SayAry(15)='@ 13,15 SAY "{Menu Button}"'
HotKey(15) = "M16w+/n"
SayAry(16)='@ 14, 6 SAY "« PROCEED »"'
SayAry(17)='@ 14,29 SAY "< CANCEL >"'
HotKey(17) = "C31w+/n"
HotKeys = "A..J...P...O..M.C"
** -- Color of Menu Choice --
DIMENSION SayColor(17)
SayColor( 1)='BG+/N'
SayColor( 2)='BG+/N'
SayColor( 3)='BG+/N'
SayColor( 4)='BG+/N'
SayColor( 5)='BG+/N'
SayColor( 6)='BG+/N'
SayColor( 7)='BG+/N'
SayColor( 8)='BG+/N'
SayColor( 9)='BG+/N'
SayColor(10)='BG+/N'
SayColor(11)='BR+/N'
SayColor(12)='BR+/N'
SayColor(13)='BR+/N'
SayColor(14)='BR+/N'
SayColor(15)='R+/N'
SayColor(16)='GR+/N'
SayColor(17)='GR+/N'
* --- Paints titles & borders on the screen
SET COLOR TO G+/N
** -- Set Size of Display Windows -- **
DEFINE WINDOW Button FROM 6,16 TO 21,62 none
ACTIVATE WINDOW Button
@ 0,0,15,46 BOX "╔═╗║╝═╚║ "
@ 0, 7 SAY "[ Projection Report Print Options ]"
SET COLOR TO W+/N
@ 1, 3 SAY "*- Contractors -*"
@ 1,25 SAY "*- Job Selection -*"
@ 5,27 SAY "*- Output To -*"
@ 5, 4 SAY "*- Sort By -*"
@ 10,10 SAY "*- Include In Report -*"
@ 0, 0 SAY CHR(254) && Close window icon
** -- Local Variables
Mpt = 1 && Menu Pointer
MptMax = 17 && Last Menu Choice
LastColor='' && Last Color Set
cnt =1
DO WHILE cnt <= MptMax && Display Menu Choices
IF GroupFlag(cnt) < 0 && Re-set text button flags
T_F(cnt) = .F.
ENDIF
IF GroupFlag(cnt) >= 0
SayAry(cnt)=STUFF(SayAry(cnt),15,1,IIF(T_F(cnt),IIF(GroupFlag(cnt)=0,'X','*'),' '))
ENDIF
IF LastColor # SayColor(cnt)
SET COLOR TO &SayColor(cnt)
LastColor = SayColor(cnt)
ENDIF
&SayAry(cnt)
IF SUBSTR(HotKeys,cnt,1) # '.' && Display Hot Key
ColorStr = SUBSTR(HotKey(cnt),4)
SET COLOR TO &ColorStr
@ ROW(),VAL(SUBSTR(HotKey(cnt),2,2)) SAY SUBSTR(HotKey(cnt),1,1)
LastColor = ColorStr
ENDIF
cnt = cnt +1
ENDDO
DO WHILE .T.
** ---------- Display Highlite and get key press ------------
SET COLOR TO w+/r
&SayAry(Mpt) && Display Highlite
Ky = INKEY(0,'MH') && Get Key Press ******************
SET COLOR TO &SayColor(Mpt) && Color
&SayAry(Mpt) && Turn Highlite Off
IF SUBSTR(HotKeys,Mpt,1) # '.' && Display Hot Key
ColorStr = SUBSTR(HotKey(Mpt),4)
SET COLOR TO &ColorStr
@ ROW(),VAL(SUBSTR(HotKey(Mpt),2,2)) SAY SUBSTR(HotKey(Mpt),1,1)
LastColor = ColorStr
ENDIF
IF Ky = 151 && Mouse Click, so decode
Ky = 13
DO CASE
CASE MROW() = 0 .AND. MCOL() = 0
Ky = 27 && ESCape
CASE MROW() = 2 .AND. MCOL()>= 3 .AND. MCOL() <= 21
Mpt = 1
CASE MROW() = 3 .AND. MCOL()>= 3 .AND. MCOL() <= 19
Mpt = 2
CASE MROW() = 2 .AND. MCOL()>= 25 .AND. MCOL() <= 44
Mpt = 3
CASE MROW() = 3 .AND. MCOL()>= 25 .AND. MCOL() <= 46
Mpt = 4
CASE MROW() = 6 .AND. MCOL()>= 3 .AND. MCOL() <= 19
Mpt = 5
CASE MROW() = 7 .AND. MCOL()>= 3 .AND. MCOL() <= 19
Mpt = 6
CASE MROW() = 8 .AND. MCOL()>= 3 .AND. MCOL() <= 19
Mpt = 7
CASE MROW() = 6 .AND. MCOL()>= 25 .AND. MCOL() <= 46
Mpt = 8
CASE MROW() = 7 .AND. MCOL()>= 25 .AND. MCOL() <= 44
Mpt = 9
CASE MROW() = 8 .AND. MCOL()>= 25 .AND. MCOL() <= 44
Mpt = 10
CASE MROW() = 11 .AND. MCOL()>= 3 .AND. MCOL() <= 18
Mpt = 11
CASE MROW() = 12 .AND. MCOL()>= 3 .AND. MCOL() <= 21
Mpt = 12
CASE MROW() = 11 .AND. MCOL()>= 25 .AND. MCOL() <= 43
Mpt = 13
CASE MROW() = 12 .AND. MCOL()>= 25 .AND. MCOL() <= 43
Mpt = 14
CASE MROW() = 13 .AND. MCOL()>= 15 .AND. MCOL() <= 30
Mpt = 15
CASE MROW() = 14 .AND. MCOL()>= 6 .AND. MCOL() <= 17
Mpt = 16
CASE MROW() = 14 .AND. MCOL()>= 29 .AND. MCOL() <= 41
Mpt = 17
OTHERWISE
LOOP
ENDCASE
ENDIF Ky = 151 && Mouse Click
** -- Test for Hot Key --
IF Ky > 32 .AND. Ky < 127 && ASCII key pressed
IF Ky > 96
Ky = Ky -32 && Convert to Upper Case
ENDIF
IF CHR(Ky) $ HotKeys && Hot Key found
Mpt = AT(CHR(Ky),HotKeys)
Ky =32
ENDIF
ENDIF
** ---------------- Process KEY strokes ---------------------
DO CASE
CASE Ky=5.OR.Ky=56.OR.Ky=19.OR.Ky=52 && [Up] [Left]
Mpt = IIF(Mpt=1,MptMax,Mpt-1)
CASE Ky=24.OR.Ky=50.OR.Ky=4.OR.Ky=54 && [Down] [Right]
Mpt = IIF(Mpt=MptMax,1,Mpt+1)
CASE Ky = 9 && Tab to next group
cnt = Mpt
ButRef = GroupFlag(Mpt)
DO WHILE cnt <= MptMax
IF GroupFlag(cnt) # ButRef
Mpt = cnt
EXIT
ENDIF
cnt = cnt +1
ENDDO
Mpt = IIF(cnt>MptMax,1,Mpt)
CASE Ky = 15 && Shift Tab prev group
cnt = Mpt
ButRef = GroupFlag(Mpt)
DO WHILE cnt >= 1
IF GroupFlag(cnt) # ButRef
Mpt = cnt
EXIT
ENDIF
cnt = cnt -1
ENDDO
Mpt = IIF(cnt<1,MptMax,Mpt)
CASE Ky = 27 && ESCape
T_F(17) = .T.
acti scre
do MsgError with 'w+/r',24,'This is a test call upon Escape exit.'
EXIT && -- MENU Exit to abort
CASE Ky = 23 .OR. Ky = 10 && Ctrl-End or Ctrl-Enter
Ky = 10 && Force to Ctrl-Enter code
T_F(16) = .T.
EXIT && -- MENU Exit to proceed
CASE Ky=28.OR.Ky=72.OR.Ky=104 && [F1] [Hh] Help
** put up the window
SET COLOR TO RB+/N
DEFINE WINDOW ButHelp FROM 2,10 TO 20,68 ;
TITLE '[ Control Panel Help ]' DOUBLE ;
COLOR G+/N,RB+/N,RB+/N
ACTIVATE WINDOW ButHelp
@ ROW()+1,2 SAY 'The following keys are active while using this panel.'
@ ROW()+1,2 SAY '--------KEY------ACTION------------------------------'
@ ROW()+1,2 SAY ' [Enter] Select the item highlighted.'
@ ROW()+1,2 SAY ' [Space] Select the item highlighted.'
@ ROW()+1,2 SAY '[Ctrl][Enter] Exit the menu and proceed.'
@ ROW()+1,2 SAY ' [Ctrl][End] Exit the menu and proceed.'
@ ROW()+1,2 SAY ' [ESC] Exit without selecting.'
@ ROW()+1,2 SAY ' [Arrows] Up/Down, move the highlighted item.'
@ ROW()+1,2 SAY ' [Arrows] Right/Left, move the highlighted item.'
@ ROW()+1,2 SAY ' [Tab] Move Highlight forward one group'
@ ROW()+1,2 SAY ' [Shift][Tab] Move Highlight back one group'
@ ROW()+1,2 SAY ' [Home] Go to the first item.'
@ ROW()+1,2 SAY ' [End] Go to the last item.'
@ ROW()+1,2 SAY ' [F1] Displays this screen.'
@ ROW()+1,2+14 SAY '<Press Any Key To Return>'
cnt=INKEY(0,'HM')
RELEASE WINDOWS ButHelp
ACTIVATE WINDOW Button
CASE Ky = 1 .OR. Ky = 55 && Home
Mpt = 1
CASE Ky = 6 .OR. Ky = 49 && End
Mpt = MptMax
CASE Ky = 13 .OR. Ky = 32 && ENTER or SPACE
IF GroupFlag(Mpt) >= 0 && Is Button or Check Box
** No action if Button is ON
IF GroupFlag(Mpt) = 0 .OR. .NOT. T_F(Mpt)
DO CASE && Tag Action Initiated Here
CASE Mpt=1
hide wind Button
activate screen
save scre
do nothing
rest scre
ACTIVATE WINDOW Button
CASE Mpt=4
activate screen
DO Msg24 with "This is a test call to Msg24.Prg from a button."
ans=Inkey(5)
ACTIVATE WINDOW Button
CASE Mpt=8
hide wind Button
acti scre
save scre
Do Nothing
rest scre
ACTIVATE WINDOW Button
CASE Mpt=12
acti scre
Do Msg24 with "This is a test call to Msg24.prg from a check box."
ans=Inkey(5)
ACTIVATE WINDOW Button
ENDCASE
** Set True / False Flag
T_F(Mpt) = IIF(GroupFlag(Mpt)#0,.T.,.NOT.T_F(Mpt))
** Set display of button On or Off
SayAry(Mpt)=STUFF(SayAry(Mpt),15,1,IIF(T_F(Mpt),IIF(GroupFlag(Mpt)=0,'X','*'),' '))
** If Button, Need to clear all buttons in this group
IF GroupFlag(Mpt) # 0 && Ignore if Check Box
ButRef= GroupFlag(Mpt) && Button Reference
cnt =1
DO WHILE cnt <= MptMax
IF GroupFlag(cnt) = ButRef && Button group match
IF cnt # Mpt && Clear Button
T_F(cnt) = .F.
SayAry(cnt)=STUFF(SayAry(cnt),15,1,' ')
ENDIF
ColorStr = SayColor(cnt)
IF LastColor # ColorStr
SET COLOR TO &ColorStr
LastColor = ColorStr
ENDIF
SayString = LEFT(SayAry(cnt),15)+'"'
&SayString && Display Menu Choice
ENDIF
cnt = cnt +1
ENDDO
ENDIF
ENDIF
ELSE && EXIT or Menu Choice
DO CASE
CASE Mpt=15
acti scre
Do Msg24 with 'Menu Button for a prg call if you like.'
ans=Inkey(5)
ACTIVATE WINDOW Button
CASE GroupFlag(Mpt) = -1
KEYBOARD CHR(10)
CASE GroupFlag(Mpt) = -2
KEYBOARD CHR(27)
ENDCASE
ENDIF
ENDCASE
ENDDO && ------------------ Main Loop ---------------------------
* ---Closing operations.
RELEASE WINDOW Button
SET COLOR OF SCHEME 1 TO &ButtSch1 && Restore Colors [FoxPro]
SET COLOR OF SCHEME 2 TO &ButtSch2 && Restore Colors [FoxPro]
RETURN
* EOF: BPTEST.PRG